perm filename MPRNT.F4[Y,MUS] blob sn#068326 filedate 1973-12-01 generic text, type T, neo UTF8
00100	C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
00200	C *** READS DATA FROM CLFX, TAIL, FERM, BREP, REST, DRAW1, DRAW2
00250	C  LOAD WITH PPSRT, PLTCMD, NOTWRT, ITMSBX, TREST, CLFZ, LOOK
00300	
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS
00600		COMMON /DL/IXRX,SAVER,NAME
00700		DIMENSION V(78),LIST(200)
00800		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
01000		COMMON/ALF/INP(3),ML/XRN/RN(4000)/STF/RSTFAC(8),RSTJC
01100		COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01200		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/POSI/STFF(8),JJB,POS
01300		COMMON/DPY/GO,RXGP,TOP,BOT
01400		EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
01500		1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JF,JQ(4)),(RJG,RJQ(5))
01600	     1,(RJD,RJQ(2)),(RJC,RJQ(1)),(I1,INP(1)),(V,RN(3000))
01700		1,(LIST,RN(3100))
02100		DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
02500		1 ,IP/'P'/
02700	
02800		TOP2=-999
02900		RXGP=0
03000		I1=0
03100	C  RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
03600	2	PLOTIT=0
03700		RSZ=.845
03800		TOP=-999
03900		BOT=999
04200		PLT=0
04300		PWDS(1)=1.
04400		EDX=-1
04600		DO 1402 K=1,8
04700	1402	RSTFAC(K)=1.
04900		M=1
05000		ITEM=0
05100		IXRX=0
05400		I=1
06900	58	GO=-1
07000		GO TO 5504
07100	
07200	
07300	11	CALL NOTWRT
07400	57	IF(PLT)GO TO 6120
07700		ITEM=ITEM+1
08400		IF(EDX.NE.-1.AND.M.LT.I)GO TO 6120
08500		IF(PLOTIT.EQ.-2)GO TO 2311
08700		PWDS(ITEM+1)=I
08800		PLT=0
09100		GO=-1
09200	
12400	5504	IF(I1.EQ.IP)GO TO 2311
12500	59	TYPE 56
12800		ACCEPT 89,INP
18800	311	JA=0
19200		IF(I1.NE.IP)GO TO 85
19500	2311	CALL PLTCMD
19600		IF(PLOTIT.EQ.0)GO TO 3005
19700		I1=IP
19800		PLOTIT=-1
20000	C  'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
20600	89	FORMAT(72A1)
20800	
27800	6531	M=1
27900		EDX=-1
28200		DO 5532 K=1,9
28300	5532	JQ(K)=RJQ(K)
29700	590	IF(PLOTIT.EQ.-1)GO TO 121
29800		I1=0
29900	243	RJB=1.
29910	C TO RUN THROUGH DATA.
29920	241	RSZ=.845*RJB
29950		RJB=0
29960		RJC=0
29970		RJD=0
29980		TOP=-999
29990		BOT=999
30000	C  GOES TO PLOTTER
33000	85	M=1
33100		I=PWDS(ITEM+1)
33200		ITEM=0
33400	8852	PLT=1
33500		EDX=0
33700		GO=0
33800		GO TO 6120
33900	
51900	60	RSTJC=RSTFAC(JC+4)
55200	5541	POS=STFF(JC+4)
55300		JB=RHORZ(RJB)
55400	C  LINE IS DIVIDED INTO 200 POINTS.
55500		CENTR=POS
55600	551	IF(JA.EQ.4.OR.JA.EQ.10)GO TO 25
55700		IF(JA.EQ.7)GO TO 81
55800		IF(JA.LE.12.OR.JA.EQ.30)GO TO 11
55900		IF(JA.EQ.18)GO TO 80
56500		CALL ALPHA
56600		GO TO 57
56700	
56800	81	CALL KSIG
56900		GO TO 57
57000	
57100	80	CALL METER
57200		GO TO 57
57300	
57700	25	CALL ITMSUB
57800	C   BAR LINES, BEAMS, STAFF LINES ****
57900		GO TO 57
58000	
58900	3005	REWIND 21
59000	C  GUARDS AGAINST LOSSAGE!
59200		PLOTIT=-2
59400		CALL IFILE(21,NAME)
59500	C  JUMP TO READ BIG FILES
59600	2200	J=ITEM+1
59700	2202	READ(21),X,Y,
59800		1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
59814		1 LCNT,(LIST(K),K=1,LCNT)
59884		READ(21),RSTFAC,STFF
59900		ITEM=ITEM+X
60000		I=Y
60600		GO TO 6531
61700	121	IF(PLOTIT.EQ.0)GO TO 5504
61800	5121	CALL PLTSRT
61900	C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
62000		PLT=-1-JH
62100	C  (JH) P8=1 OR 2 FOR 2-PASS PLOTS
62200		M=I
62300		I=I+M-1
62400		IF(RJB.EQ.0)RJB=1.
62500		DIS=RJB*1.24
62600		IF(RJC.EQ.0)RJC=RJB
62700		RHT=RJC*1.2
62800	C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
62900		BOT=-BOT*RHT
63000		IF(TOP2.EQ.-999)GO TO 8121
63100		BOT=BOT+TOP2
63200		GO TO 9121
63300	8121	CALL PLOTS(K)
63400		RXGP=995.-BOT
63500	9121	NOMOVE=RJF+RJG*148.*RJC
63600	C  RJF=1 FOR NO MOVE AT END.  RJG=# OF STAVES TO MOVE FOR NEW STAFF 0.
63700		IXGP=JD
63800	C (JD) P4=1 FOR XGP OUTPUT
63900		IF(JE.NE.0)GO TO 1122
64000		IF(RJD.EQ.0)GO TO 6121
64100		IF(TOP2.NE.-999)RXGP=RXGP-BOT
64200	C  MOVES 0 POINT OVER EACH TIME.
64300		GO TO 1122
64400	6121	CALL PLOT(0,BOT,-3)
64500	C  MOVES PLOTTER UP IF P5=0.
64600	1122	IXRX=IXGP
64700	
64800	C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
64900	6120	IF(M.GE.I)GO TO 7120
65000		CNT=RN(M)
65200		DO 6220 K=CNT+1,10
65300		JQ(K)=0
65400	6220	RJQ(K)=0
65500		JA=RN(M+1)
65600		M=M+2
65700		RJB=RN(M)
65800		DO 9120 K=1,CNT
65900		RJQ(K)=RN(M+K)
66000	9120	JQ(K)=RJQ(K)
66100		M=CNT+M+1
66200		IF(EDX.LE.0)GO TO 60
66300		GO TO 5504
66400	
66500	7120	M=1
66600		IF(EDX)GO TO 71201
66700		IF(PLT.EQ.1)EDX=-1
66800		PLT=0
66900	C  RETURNS FOR 'SL'=SAVE LAST
67000		GO TO 5504
67100	71201	X=50*RHT
67200		TOP=TOP*RHT+X
67300		IF(NOMOVE.NE.0)TOP=0
67400		IF(NOMOVE.GT.1)TOP=NOMOVE
67500		IF(IXGP.EQ.0)CALL PLOT(0,TOP,3)
67600		TOP2=TOP
67700		GO TO 2
67800	C  TO MOVE 'PLOTTER' FOR XGP OUTPUT
68000	C  MOVES PLOTTER UP
68100	C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
68400	
68500	56	FORMAT(' PXG OR PXC'/)
68800		END